﻿module producePolygon

open System
open tilingTools

let giftWrap (V : (int * int) []) threshold = 
    // determine the left&bottommost coordinate (sorting the array for the minimum tuple)
    // fst to access first member of tuple, snd to access second tuple (x and y, respectively)
    // first we initialize all the variables
    let sA = Array.sort V
    let n = sA.GetLength 0
    let origin = sA.[0]
    tilingTools.conTextAdd ("origin: "+string origin)
    let maxP = sA.[n-1]
    tilingTools.conTextAdd ("last: "+string maxP)
    let mutable (convexHull : (int * int) []) = [||]
    let mutable (upper : (int * int) []) = [||]
    let mutable (lower : (int * int) []) = [||]

    // det = twice the signed area of the triangle p0, p1, p2
    let area2 p0 p1 p2 = (fst p0) * ((snd p1)-(snd p2)) + (fst p1) * ((snd p2)-(snd p0)) + (fst p2) * ((snd p0)-(snd p1))

    // separate upper/lower half of convex hull
    for p = 0 to n-1 do
        tilingTools.conTextAdd("p = "+string p)
        let det = area2 origin maxP sA.[p]
        tilingTools.conTextAdd ("det = "+string det)

        if (det >= threshold) then
            upper <- Array.append upper [|sA.[p]|]
        elif (det < threshold) then
            lower <- Array.append lower [|sA.[p]|]
    done

    // search to see if the origin and max are in already
    let searchAppend = 
        if (Array.tryFind (fun elem -> elem = maxP) upper) = None then
            upper <- Array.append upper [|maxP|]
        if (Array.tryFind (fun elem -> elem = origin) upper) = None then
            upper <- Array.append [|origin|] upper
        if (Array.tryFind (fun elem -> elem = maxP) lower) = None then
            lower <- Array.append lower [|maxP|]
        if (Array.tryFind (fun elem -> elem = origin) lower) = None then
            lower <- Array.append [|origin|] lower
    

    printfn "upper: %A" upper
    printfn "lower: %A" lower

    // initializing vars used later
    let r = upper.GetLength 0
    let l = lower.GetLength 0

    tilingTools.conTextAdd "----------------------------------------------\nStarting Upper Trace..."

    let wrapUpper = 
        let mutable p = 1
        let mutable (upperAppend : (int * int) []) = [||]
        tilingTools.conTextAdd ("----------------------------------------------\nnumber of upper vertices: "+ string (r-1))
        while p<r do
            tilingTools.conTextAdd ("last: "+string maxP)
            tilingTools.conTextAdd ("p_upper = "+string p)
            let currentP = upper.[p]
            let prevP = upper.[p-1]
            tilingTools.conTextAdd ("currentP: "+string currentP)
            tilingTools.conTextAdd ("prevP: "+string prevP)
            let mutable assumeI = 0
            // is there anything to the right of the current point?
            if Array.tryFindIndex (fun elem -> (fst elem) > (fst currentP)) upper <> None then
                assumeI <- Array.findIndex (fun elem -> (fst elem) > (fst currentP)) upper
            else
                assumeI <- p
            let assumeP = upper.[assumeI]
            let mutable nextP = (0,0)
            if (p+1)<r then
                nextP <- upper.[p+1]
                tilingTools.conTextAdd ("nextP: "+string nextP)
            tilingTools.conTextAdd ("assumeP: "+string assumeP)
            // if the next point is on some kind of diagonal
            // use nextP instead of currentP
            if (fst nextP <> fst currentP) && (snd nextP <> snd currentP) && (snd nextP > snd currentP) then    
                // if diagonal point is below
                if (p+1)<r then
                    tilingTools.conTextAdd "This point signals an intrusion."
                    // run what we assume to be the rest of the function
                    // we must get all new variables as now we do two things at once
                    let betweenP = upper.[p+2]
                    tilingTools.conTextAdd ("betweenP: "+string betweenP)
                    // where is the point in between the two?
                    // if the point in between is just above nextP
                    if fst betweenP = fst nextP then
                        upper.[p+2] <- nextP
                        upper.[p+1] <- betweenP
                        tilingTools.conTextAdd ("new nextP: "+string upper.[p+2])
                        tilingTools.conTextAdd ("new currentP: "+string upper.[p+1])
                        upperAppend <- Array.append upperAppend [|currentP|]
                        p <- p + 1
                    else
                        failwith "Error. There is an intrusion that is too close to an endpoint (not really possible). Check your threshold value."
                elif currentP = maxP then
                    tilingTools.conTextAdd "We have reached the end."
                    upperAppend <- Array.append upperAppend [|currentP|]
                    p <- r
                else
                    failwith "The point is on some kind of diagonal but is neither an intrusion or extrusion. Check your threshold value."
            // catch-all
            else
                // if the next point is directly above the current point
                // we need to search if there is a block/vertchord to the right or not
                // *********** MODIFY FOR LEFT SIDE RATHER THAN RIGHT SIDE
                if fst prevP = fst currentP then
                    tilingTools.conTextAdd "This point is straight above"
                    // do the search here for if the next fst lower.[i+1] > currentP (meaning there is something to the right)
                    // if there is a point do this
                    // // don't forget to take the indices out that have this (just a comment, don't use this)
                    // if next index after this current one is on same vert then this isn't a line continuation... we must detour to the right
                    // **** this detour is between prevP and currentP, making sure it is not a stair step
                    if (Array.tryFindIndex (fun elem -> (fst elem) > (fst currentP)) upper <> None) && ((assumeI+1) < r) then
                        tilingTools.conTextAdd "There is a point to the right"
                        //printfn "assumeI: %d" assumeI
                        let maybeVP = upper.[assumeI+1]
                        tilingTools.conTextAdd ("nmaybeVP: "+string maybeVP)
                        let returnP = nextP
                        // the left-intrusion must have matching x but the next point after the extrusion must be different, with a constraint *** What to do about p-constraint?
                        if ((fst assumeP) = (fst maybeVP)) && ((fst returnP) < (fst assumeP)) && p+2<r then
                            tilingTools.conTextAdd "This point signals an left-intrusion"
                            // move the indices of the extruding points to before the next point (currentP)
                            // currentP index = p, prevP = p-1
                            let reAssignArray = 
                                upper.[p+4] <- upper.[p+2]
                                upper.[p+3] <- nextP
                                upper.[p] <- currentP
                                upper.[p+1] <- assumeP
                                upper.[p+2] <- maybeVP
                            upperAppend <- Array.append upperAppend [|currentP|]
                            // set p so it is two indices over *** WHY????
                            p <- p + 1
                        // if there is no point
                        else
                            tilingTools.conTextAdd "This is a standard vertical line"
                            upperAppend <- Array.append upperAppend [|currentP|]
                            p <- p + 1
                    else
                        upperAppend <- Array.append upperAppend [|currentP|]
                        p <- p + 1
                elif currentP = maxP then
                    tilingTools.conTextAdd "We have reached the end."
                    upperAppend <- Array.append upperAppend [|currentP|]
                    p <- r
                // if the current point is to the right of the previous point
                elif snd prevP = snd currentP then
                    tilingTools.conTextAdd "Point is to the right"
                    upperAppend <- Array.append upperAppend [|currentP|]
                    p <- p + 1
                // report an error
                else
                    failwith "Encountered an unknown problem. Please check your threshold values."
        done
        // append the upperAppend to convex Hull
        convexHull <- Array.append convexHull upperAppend

    tilingTools.conTextAdd "----------------------------------------------\n\nStarting Lower Trace..."
    // wrap the lower section
    let wrapLower = 
        let mutable p = 1
        let mutable (lowerAppend : (int * int) []) = [||]
        tilingTools.conTextAdd ("----------------------------------------------\nnumber of lower vertices: "+string (l-1))
        while p<l do
            printfn "\np_lower = %d" p
            let currentP = lower.[p]
            let prevP = lower.[p-1]
            printfn "currentP: %O" currentP
            printfn "prevP: %O" prevP
            let mutable assumeI = 0
            if Array.tryFindIndex (fun elem -> (fst elem) > (fst currentP)) lower <> None then
                assumeI <- Array.findIndex (fun elem -> (fst elem) > (fst currentP)) lower
            else
                assumeI <- p
            let assumeP = lower.[assumeI]
            let mutable nextP = (0,0)
            if (p+1)<l then
                nextP <- lower.[p+1]
                printfn "nextP: %O" nextP
            printfn "assumeP: %O" assumeP
            // if the next point is on some kind of diagonal
            // use nextP instead of currentP
            //if (fst prevP <> fst currentP) && (snd prevP <> snd currentP) && (snd currentP < snd prevP) then
            if (fst nextP <> fst currentP) && (snd nextP <> snd currentP) && (snd nextP < snd currentP) then    
                // if diagonal point is below
                if (p+1)<l then
                    tilingTools.conTextAdd "This point signals an intrusion."
                    // run what we assume to be the rest of the function
                    // we must get all new variables as now we do two things at once
                    let betweenP = lower.[p+2]
                    printfn "betweenP: %O" betweenP
                    // where is the point in between the two?
                    // if the point in between is just above nextP
                    if fst betweenP = fst nextP then
                        lower.[p+2] <- nextP
                        lower.[p+1] <- betweenP
                        printfn "new nextP: %O" lower.[p+2]
                        printfn "new currentP: %O" lower.[p+1]
                        let y1 = snd currentP
                        let y2 = snd betweenP
                        let x0 = fst prevP
                        let x2 = fst betweenP
                        // our appendix will have the set of points for two points (the corner)
                        // first we trace across to the between P
                        // let appendMe = Array.init (x2-x0) (fun j -> (j+x0, y2))
                        // lowerAppend <- Array.append lowerAppend [|betweenP|]
                        // then we trace down to the current P
                        //let appendMe2 = Array.init (y2-y1) (fun j -> (x2, j+y1))
                        lowerAppend <- Array.append lowerAppend [|currentP|]
                        // skip the 'next' point in array as we know it is a vertex before the diagonal
                        p <- p + 1
                    else
                        failwith "Error. There is an intrusion that is too close to an endpoint (not really possible). Check your threshold value."
                // ***!!!!!!IMPORTANT:::: Maybe we need to elif maxP and currentP and perform the appendation here
                elif currentP = maxP then
                    printfn "We have reached the end."
                    // lowerAppend <- Array.append lowerAppend [|currentP|]
                    p <- l
                else
                    failwith "The point is on some kind of diagonal but is neither an intrusion or extrusion. Check your threshold value."
            // catch-all
            else
                // if the next point is directly above the current point
                // we need to search if there is a block/vertchord to the right or not
                if fst prevP = fst currentP then
                    printfn "This point is straight above"
                    // do the search here for if the next fst lower.[i+1] > currentP (meaning there is something to the right)
                    // if there is a point do this
                    // // don't forget to take the indices out that have this (just a comment, don't use this)
                    // if next index after this current one is on same vert then this isn't a line continuation... we must detour to the right
                    // **** this detour is between prevP and currentP, making sure it is not a stair step
                    if (Array.tryFindIndex (fun elem -> (fst elem) > (fst currentP)) lower <> None) then
                        printfn "There is a point to the right"
                        //printfn "assumeI: %d" assumeI
                        let maybeVP = lower.[assumeI+1]
                        printfn "maybeVP: %O" maybeVP
                        let returnP = nextP
                        /// BAD LOGIC BELOW:
                        // let extrusionOver = lower.[assumeI+2]
                        // printfn "extrusionOver: %O" extrusionOver
                        // the extrusion must have matching x but the next point after the extrusion must be different, with a constraint
                        if ((fst assumeP) = (fst maybeVP)) && ((fst returnP) < (fst assumeP)) && p+2<l then
                            printfn "This point signals an extrusion"
                            // move the indices of the extruding points to before the next point (currentP)
                            // currentP index = p, prevP = p-1
                            let reAssignArray = 
                                lower.[p+4] <- lower.[p+2]
                                lower.[p+3] <- nextP
                                lower.[p] <- currentP
                                lower.[p+1] <- assumeP
                                lower.[p+2] <- maybeVP
                            // create the extrusion
                            let x0 = fst currentP
                            let x1 = fst assumeP
                            let x2 = fst maybeVP
                            let y0 = snd currentP
                            let y1 = snd assumeP
                            let y2 = snd maybeVP
                            // let appendMe1 = Array.init (x1-x0) (fun j -> (j+x0, y0))
                            // let appendMe2 = Array.init (y2-y1) (fun j -> (x1, j+y1))
                            // lowerAppend <- Array.append lowerAppend [|assumeP|]
                            // lowerAppend <- Array.append lowerAppend [|maybeVP|]
                            lowerAppend <- Array.append lowerAppend [|currentP|]
                            // set p so it is two indices over *** WHY????
                            p <- p + 1
                        // if there is no point
                        else
                            printfn "This is a standard vertical line"
                            let x = fst prevP
                            let y0 = snd prevP
                            let y1 = snd currentP
                            // let appendMe = Array.init (abs (y1-y0)) (fun j -> (x, j+y0))
                            lowerAppend <- Array.append lowerAppend [|currentP|]
                            p <- p + 1
                    else
                        let x = fst prevP
                        let y0 = snd prevP
                        let y1 = snd currentP
                        // let appendMe = Array.init (abs (y1-y0)) (fun j -> (x, j+y0))
                        lowerAppend <- Array.append lowerAppend [|currentP|]
                        p <- p + 1
                // if the current point is to the right of the previous point
                elif snd prevP = snd currentP then
                    printfn "Point is to the right"
                    let y = snd prevP
                    let x0 = fst prevP
                    let x1 = fst currentP
                    // let appendMe = Array.init (abs (x1-x0)) (fun j -> (j+x0, y))
                    lowerAppend <- Array.append lowerAppend [|currentP|]
                    p <- p + 1
                // report an error
                else
                    failwith "Encountered an unknown problem. Please check your threshold values."
        done
        // append the lowerAppend to convex Hull
        Array.Reverse lowerAppend
        convexHull <- Array.append convexHull lowerAppend

    // append the first value to the beginning and end and reverse
    convexHull <- Array.append convexHull [|origin|]
    convexHull <- Array.append [|origin|] convexHull
    Array.Reverse convexHull

    // create list of coordinates for x side
    let createXside x0 x1 =
        let x = x1-x0
        // if tiling direction is going west
        if x < 0 then
            let outputX = [ for i in 0 .. (abs x)-1 -> x0 - i ]
            outputX
        // if tiling direction is going east
        else
            // List.rev
            let outputX = List.rev [ for i in 1 .. (abs x) -> x1 - i ]
            outputX
    // create list of coordinates for y side
    let createYside y0 y1 =
        let y = y1-y0
        // if tiling direction is going south
        if y < 0 then
            let outputY = [ for i in 0 .. (abs y)-1 -> y0 - i ]
            outputY
        // if tiling direction is going north
        else
            let outputY = List.rev [ for i in 1 .. (abs y) -> y1 - i ]
            outputY

    let produceBorders (borders : (int * int) []) =
        let xLength = borders.GetLength 0
        let mutable borderList = [||]
        for i = 1 to xLength-1 do
            let mutable tempBorderList = [||]
            // creating coordinates
            let x0 = fst borders.[i-1]
            let y0 = snd borders.[i-1]
            let x1 = fst borders.[i]
            let y1 = snd borders.[i]
            // tiles are horizontal
            if x0 <> x1 && y0 = y1 then
                let side = createXside x0 x1
                let p = side.Length
                // append new side
                tempBorderList <- Array.init p (fun index -> (side.[index], y0))
            // tiles are vertical
            elif x0 = x1 && y0 <> y1 then
                let side = createYside y0 y1
                let o = side.Length
                // append new side
                tempBorderList <- Array.init o (fun index -> (x0, side.[index]))
            // report an error
            else
                failwith "Error in assumption of order."
            borderList <- Array.append borderList tempBorderList
        done
        borderList <- Array.append borderList [|borders.[0]|]
        borderList


    printfn "%A" convexHull

    // return the convex hull
    let convexHullBorders = produceBorders convexHull
    convexHullBorders

// test shapes (array of vertices)
let V = [| (0,0);
           (1,0);
           (1,1);
           (2,1);
           (2,2);
           (3,2);
           (3,1);
           (4,1);
           (4,2);
           (5,2);
           (5,0);
           (6,0);
           (6,2);
           (7,2);
           (7,3);
           (6,3);
           (6,4);
           (7,4);
           (7,5);
           (0,5);
        |]

let D = [| (0,0);
           (0,1);
           (1,1);
           (1,2);
           (0,2);
           (0,3);
           (3,3);
           (3,0);
        |]

let J = [| (0,0);
           (0,1);
           (1,1);
           (1,2);
           (2,2);
           (2,3);
           (3,3);
           (3,0);
        |]